
; Misc test cases

(define *test-global*)

(define-test-suite misc-tests "misc-tests" (lambda ()

  ; global variable access
  (exception-raise-test *test-global* "global (raising undefined exception)" (enum op global))  
  (set! *test-global* 123)
  (arith-test *test-global* "set-global!, global" 123)
     
  (bool-test false (false) "(false)" #f)
  
  (bool-test (eq? (unspecific) (unspecific)) "unspecific" #t)
 
  (exception-raise-test unassigned-check (unassigned-check (unassigned)) "unassigned-check1" (enum op unassigned-check))
  
  (let ((raised? #f))
    (exception-test "unassigned-check2" (enum op unassigned-check)
      (lambda (opcode reason . args)
        (set! raised? #t))
      (lambda ()
        (unassigned-check #f) ; this should not raise any exception
        (not raised?))))

  (bool-test assq (eq? (assq 'x '()) #f) "assq1" #t)
  (bool-test assq (if (eq? (assq 'c '((a . 0) (b . 1) (c . 3) (d . 4))) #f) #t #f) "assq2" #f)
  
  (bool-test make-weak-pointer (weak-pointer? (make-weak-pointer 1)) "make-weak-pointer" #t)
  
  (bool-test intern (eq? 'symbol (intern "symbol")) "intern" #t) ; intern is for string->symbol lookup (weird name)
     
  (bool-test immutable? (immutable? (make-vector 4 #f)) "immutable?" #f)
  (bool-test make-immutable! (immutable? (make-immutable! (make-vector 4 #f))) "make-immutable!" #t)
  
  (thunk-test location-defined? "location-defined?, set-location-defined?!"
    (lambda ()
      (let ((loc (make-location 1000 #f)))
        (set-location-defined?! loc #t)
        (location-defined? loc))))               
        
  ; Characters, scalar-values, encoding
  ;                   
  (bool-test (char=? #\A (scalar-value->char (char->scalar-value #\A))) 
     "((char=? #\\A (scalar-value->char (char->scalar-value) #\\A))" #t)
  
  (let* ((character (scalar-value->char 228)) ; german umlaut for a
         (encoding  (enum text-encoding-option utf-8))
         (buffer    (make-byte-vector 2 0))
         (set-buffer!
           (lambda ()
             (byte-vector-set! buffer 0 195)
             (byte-vector-set! buffer 1 164)))
         (clear-buffer!
           (lambda ()
             (byte-vector-set! buffer 0 0)
             (byte-vector-set! buffer 1 0)))
         (check-buffer
           (lambda ()
             (and (= (byte-vector-ref buffer 0) 195)
                  (= (byte-vector-ref buffer 1) 164)))))
    
    (thunk-test char->utf "char->utf"
      (lambda ()
        (clear-buffer!)
        (receive (ok? count) (char->utf encoding character buffer 0 2)
          (and ok? 
               (= count 2)
               (check-buffer)))))
        
    (thunk-test char->utf "char->utf!"
      (lambda ()
        (clear-buffer!)
        (char->utf encoding character buffer 0 2) ; not expecting a result compiles to char->utf!
        (check-buffer)))                  
           
    (thunk-test char->utf "utf->char"
      (lambda ()
        (set-buffer!)
        (receive (result count) (utf->char encoding buffer 0 2)
          (and (not (eq? result #f))
               (char=? result character)
               (= count 2)))))   
           
    (thunk-test utf->char "utf->char!"
      (lambda ()
        (set-buffer!)
        (utf->char encoding buffer 0 2) ; use the utf->char! which does not return anything     
        #t))
    )
          
  (exception-raise-test trap (trap 123) "trap" (enum op trap)) 
  
  ; test the parameter/returnvalue passing between code and exception handler
  (exception-test trap "exception handling" (enum op trap)
    (lambda (opcode reason arg)
      (+ arg 1))       ; just increment the arg
    (lambda ()
      (= (trap 1) 2))) ; check the result

  ; there is no good way to test the result of these, so just execute them
  ; to see that the code generation handled them correctly
  ;
  (newline)
  (write-string "memory-status (heap-size): ")
  (write-number (memory-status (enum memory-status-option heap-size) #f))
  (newline)
  
  (write-string "time (cheap-time): ")
  (write-number (time (enum time-option cheap-time) #f))
  (newline)
  
  (write-string "system-parameter (host-architecture): ")
  (write-string (system-parameter (enum system-parameter-option host-architecture)))
  (newline)
  
  (write-string "make-double")
  (make-double)
  ((lambda (make-double)
     (make-double))
   make-double)
  (newline)
  
  (write-string "os-error-message: ")
  (write-byte-vector (os-error-message 0) *default-output-port*)
  (newline)
  
  (write-string "find-all: ")
  (let ((all (find-all 2))) ;; all vectors
    (if all
      (write-number (vector-length all))
      (write-string "#f")))
  (newline)

  (write-string "find-all-records: ")
  (let ((all (find-all-records (false))))
    (if all
      (write-number (vector-length all))
      (write-string "#f")))
  (newline)
  
  (write-string "add-finalizer!")
  (add-finalizer! (make-vector 10 #f) (lambda (vec) #f))
  (newline)
  
  ; This will raise an exception this way, but we just want to check
  ; that the opcode is generated/called properly and not its function
  ; so there is no need for a full record-type system here 
  (write-string "record-type<=?")
  (call-with-exception-handler (enum op record-type<=?)  ; catch the exception
    (lambda (opcode reason . args) (unspecific))
    (lambda ()
      (record-type<=? #f #f)))
  (newline)   
  
  ; (write-string "wait")
  ; (wait 100 #f)  ; just hits a breakpoint. not very useful
  ; (newline)
  
  ; This does not work in the VM running in Scheme
  (if (is-real-vm?)
    (begin
      (write-string "collect")
      (collect)
      (newline)))

  ))